home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / ISAMEXPT / ISAMEXPT.ZIP / DATEEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-05  |  8KB  |  319 lines

  1. unit Dateedit;
  2.  
  3. (*********************************************
  4. TDateEdit -> TEdit
  5.  
  6. A date edit field with drop down calendar.
  7.  
  8. PROPERTIES:
  9.  
  10. Date - TDateTime that contains the date value of the control.
  11.  
  12. ValidDateColor - The color that "valid dates" will be rendered.
  13.  
  14. METHODS:
  15.  
  16. procedure AddValidDate - Adds a datetime value to a list of "valid dates" maintained by the
  17. control.  These dates will be drawn in the color specified by ValidDateColor.
  18.  
  19. procedure ClearValidDates - Clears all "valid dates" from the list.
  20.  
  21. function DateInList - Checks if the specified date is in the list of "valid dates".
  22.  
  23. EVENTS:
  24.  
  25. OnDateChange - Triggered whenever the Date property is updated.
  26. *********************************************)
  27.  
  28. interface
  29.  
  30. uses
  31.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  32.   Forms, StdCtrls, Calpop, Buttons, IniFiles;
  33.  
  34. type
  35.  
  36.   PTDateTime = ^TDateTime;
  37.  
  38.   TDateButton = class( TBitBtn )
  39.   private
  40.   protected
  41.      procedure Click; override;
  42.   public
  43.   published
  44.   end;
  45.  
  46.   TDateEdit = class( TEdit )
  47.   private
  48.      hBitmap: HBitmap;
  49.      FButton: TDateButton;
  50.      FDate: TDateTime;
  51.      FOnDateChange: TNotifyEvent;
  52.      FValColor: TColor;
  53.      lstDates: TList;
  54.      sSep: string[1];
  55.      sDateFmt: string[20];
  56.      Token: integer;
  57.      procedure SetToken;
  58.      procedure SelectToken;
  59.      procedure SetSeperators;
  60.   protected
  61.      nSep1, nSep2: integer;
  62.      procedure WMSize( var Message: TWMSize ); message WM_SIZE;
  63.      function GetDate: TDateTime;
  64.      procedure SetDate( dtArg: TDateTime );
  65.      procedure KeyPress( var Key: char ); override;
  66.      procedure MouseUp( Button: TMouseButton; ShiftState: TShiftState; X, Y: integer ); override;
  67.      procedure DoExit; override;
  68.      procedure DoEnter; override;
  69.   public
  70.      constructor Create( AOwner: TComponent ); override;
  71.      destructor Destroy; override;
  72.      procedure CreateParams( var Params: TCreateParams ); override;
  73.      property Date: TDateTime read GetDate write SetDate;
  74.      function DateInList( dt: TDateTime ): boolean;
  75.      procedure AddValidDate( dt: TDateTime );
  76.      procedure ClearValidDates;
  77.   published
  78.      property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
  79.      property ValidDateColor: TColor read FValColor write FValColor default clMaroon;
  80.   end;
  81.  
  82. var
  83.   frmCalendar: TfrmCalPop;
  84.  
  85. implementation
  86.  
  87. {$R DATEEDIT}
  88.  
  89. {--- TDateButton ---}
  90. procedure TDateButton.Click;
  91. var
  92.   editParent: TDateEdit;
  93. begin
  94.   editParent := TDateEdit( Parent );
  95.   frmCalendar := TfrmCalPop.Create( editParent );
  96.   frmCalendar.ShowModal;
  97.   frmCalendar.Free;
  98.   inherited Click;
  99.   EditParent.SetFocus;
  100.   EditParent.DoEnter;
  101. end;
  102.  
  103. {--- TDateEdit ---}
  104.  
  105. constructor TDateEdit.Create( AOwner: TComponent );
  106. var
  107.   ini: TIniFile;
  108. begin
  109.   inherited Create( AOwner );
  110.  
  111. { Get international time seperator }
  112.   ini := TIniFile.Create( 'WIN.INI' );
  113.   sSep := ini.ReadString( 'intl', 'sDate', '.' );
  114.   sDateFmt := ini.ReadString( 'intl', 'sShortDate', 'd.M.yyyy' );
  115.   Token := 1;
  116.   ini.Free;
  117.  
  118.   FDate := 0.0;
  119.   FButton := TDateButton.Create( self );
  120.   FButton.Visible := TRUE;
  121.   FButton.Parent := self;
  122.   FButton.TabStop:= False;
  123.   FButton.Glyph.Handle := LoadBitmap( hInstance, 'CALPOPUP' );
  124.   ControlStyle := ControlStyle - [csSetCaption];
  125.   lstDates := TList.Create;
  126.   FValColor := clBlue;
  127. end;
  128.  
  129. procedure TDateEdit.CreateParams( var Params: TCreateParams );
  130. begin
  131.   inherited CreateParams( Params );
  132.   Params.Style := Params.Style or WS_CLIPCHILDREN;
  133. end;
  134.  
  135. destructor TDateEdit.Destroy;
  136. begin
  137.   FButton := nil;
  138.   ClearValidDates;
  139.   lstDates.Free;
  140.   inherited Destroy;
  141. end;
  142.  
  143. procedure TDateEdit.WMSize( var Message: TWMSize );
  144. begin
  145.   FButton.Height := Height;
  146.   FButton.Width := Height;
  147.   FButton.Left := Width - Height;
  148.   FButton.Refresh;
  149.   if FDate = 0.0 then
  150.      Date := Now;
  151. end;
  152.  
  153. function TDateEdit.GetDate: TDateTime;
  154. begin
  155.   GetDate := FDate;
  156. end;
  157.  
  158. procedure TDateEdit.SetDate( dtArg: TDateTime );
  159. var
  160.     FormattedDate : String;
  161. begin
  162.   if FDate <> dtArg then
  163.      begin
  164.         FDate := dtArg;
  165.         Modified := TRUE;
  166.         if FDate = 0 then
  167.            Text := ''
  168.         else
  169.            Text := FormatDateTime( sDateFmt, FDate );
  170.         if Assigned( FOnDateChange ) then
  171.            FOnDateChange( self );
  172.      end;
  173. end;
  174.  
  175. procedure TDateEdit.DoEnter;
  176. begin
  177.   inherited DoEnter;
  178.   Token := 1;
  179.   SetSeperators;
  180.   SelectToken;
  181. end;
  182.  
  183. procedure TDateEdit.DoExit;
  184. begin
  185.   inherited DoExit;
  186.   try
  187.      Date := StrToDate( Text );
  188.   except
  189.      Date := Now;
  190.      SetFocus;
  191.   end;
  192. end;
  193.  
  194. (*********************************************
  195. Is the supplied data in the date list?
  196. *********************************************)
  197. function TDateEdit.DateInList( dt: TDateTime ): boolean;
  198. var
  199.   pDate: PTDateTime;
  200.   i: integer;
  201. begin
  202.   Result := FALSE;
  203.   for i := 0 to lstDates.Count - 1 do
  204.      begin
  205.         pDate := lstDates[i];
  206.         if pDate^ = dt then
  207.            begin
  208.               Result := TRUE;
  209.               Break;
  210.            end;
  211.      end;
  212. end;
  213.  
  214. (*********************************************
  215. Maintain list of valid dates.
  216. *********************************************)
  217. procedure TDateEdit.AddValidDate( dt: TDateTime );
  218. var
  219.   pDate: PTDateTime;
  220. begin
  221.   New( pDate );
  222.   pDate^ := dt;
  223.   lstDates.Add( PDate );
  224. end;
  225.  
  226. procedure TDateEdit.ClearValidDates;
  227. var
  228.   pDate: PTDateTime;
  229. begin
  230.   while lstDates.Count > 0 do
  231.      begin
  232.         pDate := lstDates[0];
  233.         Dispose( pDate );
  234.         lstDates.Delete( 0 );
  235.      end;
  236. end;
  237.  
  238. procedure TDateEdit.KeyPress( var Key: char );
  239. begin
  240.   if ( ( Key < '0' ) or ( Key > '9' ) ) and ( Key <> sSep[1] ) and ( Key <> #8 )
  241.   and (Key <> #13) then
  242.      Key := #0
  243.   else if Key = sSep[1] then
  244.      begin
  245.         if Token < 3 then
  246.            begin
  247.               Inc( Token );
  248.               SetSeperators;
  249.               SelectToken;
  250.               Key := #0;
  251.            end
  252.         else
  253.            Key := #0;
  254.      end
  255.   else
  256.      inherited KeyPress( Key );
  257. end;
  258.  
  259. (*********************************************
  260. Determine which token the user is on and highlight
  261. the entire text of that token.
  262. *********************************************)
  263. procedure TDateEdit.MouseUp( Button: TMouseButton; ShiftState: TShiftState; X, Y: integer );
  264. begin
  265.   SetToken;
  266.   SelectToken;
  267.   inherited MouseUp( Button, ShiftState, X, Y );
  268. end;
  269.  
  270. (*********************************************
  271. Set the positions of the seperators in text.
  272. *********************************************)
  273. procedure TDateEdit.SetSeperators;
  274. var
  275.   i: integer;
  276. begin
  277.   nSep1 := Pos( sSep, Text );
  278.   for i := nSep1 + 1 to Length( Text ) do
  279.      if Text[i] = sSep then
  280.         begin
  281.            nSep2 := i;
  282.            Break;
  283.         end;
  284. end;
  285.  
  286. (*********************************************
  287. Determine which token the cursor is over;
  288. *********************************************)
  289. procedure TDateEdit.SetToken;
  290. var
  291.   nPos: integer;
  292. begin
  293.   nPos := SendMessage( Handle, cb_GetEditSel, 0, 0 ) div 65536;
  294.   SetSeperators;
  295.   if nPos <= nSep1 then
  296.      Token := 1
  297.   else if nPos <= nSep2 then
  298.      Token := 2
  299.   else
  300.      Token := 3;
  301. end;
  302.  
  303. (*********************************************
  304. Select the token the cursor is on.
  305. *********************************************)
  306. procedure TDateEdit.SelectToken;
  307. begin
  308.   case Token of
  309.      1:
  310.         SendMessage( Handle, em_SetSel, 0, ( nSep1 - 1 ) * 65536 );
  311.      2:
  312.         SendMessage( Handle, em_SetSel, 0, ( nSep1 + ( nSep2 - 1 ) * 65536 ) );
  313.      3:
  314.         SendMessage( Handle, em_SetSel, 0, nSep2 + ( ( Length( Text ) ) * 65536 ) );
  315.   end;
  316. end;
  317.  
  318. end.
  319.